home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MATH / MAT / MATRIX.PAS next >
Pascal/Delphi Source File  |  1994-07-20  |  3KB  |  192 lines
  1. Unit Matrix;
  2.  
  3. Interface
  4.  
  5. type
  6. prow=^trow;
  7. trow=array[1..801] of real;
  8. psquare=^tsquare;
  9. tsquare=array[1..800] of prow;
  10.  
  11. type
  12. Pmatrix=^Tmatrix;
  13. Tmatrix=object
  14. rowcolumn:integer;
  15. m,n:psquare;
  16. s:array[1..800] of real;
  17. constructor init;
  18. procedure load(row,column:integer;value:real);
  19. procedure solve(var solution;count:integer);
  20. function check:real;
  21. destructor done;
  22. end;
  23.  
  24. Implementation
  25.  
  26. constructor tmatrix.init;
  27. var
  28. b,b1,b2,b3,b4,b5:integer;
  29. begin
  30. new(m);
  31. for b:=1 to 800 do
  32. begin
  33. new(m^[b]);
  34. end;
  35. new(n);
  36. for b:=1 to 800 do
  37. begin
  38. new(n^[b]);
  39. end;
  40. for b:=1 to 800 do
  41. begin
  42. for b1:=1 to 801 do
  43. begin
  44. m^[b]^[b1]:=0;
  45. n^[b]^[b1]:=0;
  46. end;
  47. end;
  48. end;
  49.  
  50. procedure tmatrix.load(row,column:integer;value:real);
  51. begin
  52. m^[row]^[column]:=value;
  53. n^[row]^[column]:=value;
  54. end;
  55.  
  56. procedure tmatrix.solve(var solution;count:integer);
  57. label 1,2,3,4,5,6;
  58. type
  59. s1=array[1..800] of real;
  60. var
  61. irow,i,ii,j,jm1,k,ip1,im1,l,nn:integer;
  62. big,ab,temp,sum:real;
  63. begin
  64. rowcolumn:=count;
  65. irow:=1;
  66. big:=abs(m^[1]^[1]);
  67. for i:=2 to rowcolumn do
  68.     begin
  69.     ab:=abs(m^[i]^[1]);
  70.     if (big<ab) then
  71.         begin
  72.         big:=ab;
  73.         irow:=i;
  74.         end;
  75.     end;
  76.     if (irow<>1) then
  77.         begin
  78.         for j:=1 to (rowcolumn+1) do
  79.             begin
  80.             temp:=m^[irow]^[j];
  81.             m^[irow]^[j]:=m^[1]^[j];
  82.             m^[1]^[j]:=temp;
  83.             end;
  84.         end;
  85.     for j:=2 to (rowcolumn+1) do
  86.         begin
  87.         m^[1]^[j]:=m^[1]^[j]/m^[1]^[1];
  88.         end;
  89.     for i:=2 to rowcolumn do
  90.         begin
  91.         j:=i;
  92.         for ii:=j to rowcolumn do
  93.             begin
  94.             sum:=0;
  95.             jm1:=j-1;
  96.             for k:=1 to jm1 do
  97.                 begin
  98.                 sum:=sum+(m^[ii]^[k]*m^[k]^[j]);
  99.                 end;
  100.             m^[ii]^[j]:=m^[ii]^[j]-sum;
  101.             end;
  102.         if (i<>rowcolumn) then
  103.             begin
  104.             irow:=i;
  105.             big:=abs(m^[i]^[i]);
  106.             ip1:=i+1;
  107.             for ii:=ip1 to rowcolumn do
  108.                 begin
  109.                 ab:=abs(m^[ii]^[i]);
  110.                 if (big<ab) then
  111.                     begin
  112.                     big:=ab;
  113.                     irow:=ii;
  114.                     end;
  115.                 end;
  116.             if (irow<>i) then
  117.                 begin
  118.                 for j:=1 to (rowcolumn+1) do
  119.                     begin
  120.                     temp:=m^[irow]^[j];
  121.                     m^[irow]^[j]:=m^[i]^[j];
  122.                     m^[i]^[j]:=temp;
  123.                     end;
  124.                 end;
  125.             end;
  126.         ip1:=i+1;
  127.         for j:=ip1 to (rowcolumn+1) do
  128.             begin
  129.             sum:=0;
  130.             im1:=i-1;
  131.             for k:=1 to im1 do
  132.                 begin
  133.                 sum:=sum+(m^[i]^[k]*m^[k]^[j]);
  134.                 end;
  135.             m^[i]^[j]:=(m^[i]^[j]-sum)/m^[i]^[i];
  136.             end;
  137.         end;
  138.     s1(solution)[rowcolumn]:=m^[rowcolumn]^[(rowcolumn+1)];
  139.     l:=rowcolumn-1;
  140.     for nn:=1 to l do
  141.         begin
  142.         sum:=0;
  143.         i:=rowcolumn-nn;
  144.         ip1:=i+1;
  145.         for j:=ip1 to rowcolumn do
  146.             begin
  147.             temp:=s1(solution)[j];
  148.             sum:=sum+(m^[i]^[j]*temp);
  149.             end;
  150.         s1(solution)[i]:=m^[i]^[(rowcolumn+1)]-sum;
  151.         end;
  152. for ii:=1 to rowcolumn do
  153.     begin
  154.     s[ii]:=s1(solution)[ii];
  155.     end;
  156. end;
  157.  
  158. function tmatrix.check:real;
  159. var
  160. b,b1:integer;
  161. sum,sum1:real;
  162. begin
  163. sum:=0;
  164. sum1:=0;
  165. for b:=1 to rowcolumn do
  166.     begin
  167.     for b1:=1 to rowcolumn do
  168.         begin
  169.         sum:=sum+(n^[b]^[b1]*s[b1]);
  170.         end;
  171.     sum1:=sum1+(sum-n^[b]^[(rowcolumn+1)]);
  172.     sum:=0;
  173.     end;
  174. check:=sum1;
  175. end;
  176.  
  177. destructor tmatrix.done;
  178. var
  179. b,b1:integer;
  180. begin
  181. for b:=1 to 800 do
  182. begin
  183. dispose(m^[b]);
  184. end;
  185. dispose(m);
  186. for b:=1 to 800 do
  187. begin
  188. dispose(n^[b]);
  189. end;
  190. dispose(n);
  191. end;
  192. end.